;; This file contains lsmt code
;;
;; scatterplot2-proto is required by lsmt 
;; which is a 3-dimensional scatterplot
;; no other code uses scatterplot2-proto


(defproto scatterplot2-proto () () vista-scatterplot-proto)

(defmeth scatterplot2-proto :isnew (x &rest args &key point-labels symbol color) 
"Args: x &rest args &key point-labels symbol color
X is a list of at least two equal length lists of data.  The first two lists are plotted as the scatterplot, the remaining lists are additional dimensions which may be shown with the :current-variables message. ARGS may be any keyword argument understood by the :isnew methods for graph-proto and graph-window-proto. POINT-LABELS, SYMBOL, and COLOR set the labels, symbol and color of the points." 
;(print (list x args point-labels symbol color))
  (let* ((ndim (length x))
         (npts (length (first x)))
         (w (apply #'call-next-method ndim :show nil args)))
    (when w
          (send w :add-points x)
          (when symbol (send w :point-symbol (iseq npts) symbol))
          #+color (when (and (> *color-mode* 0) color)  
                        (send w :use-color t)
                        (send w :point-color (iseq npts) color))
          (when point-labels (send w :point-label (iseq npts) point-labels)) 
          (send w :adjust-to-data))
    w))

(defun lsmt-plot (raw trans fit-trans ssp &rest args &key (show t))                    
  (let ((p (apply #'send LSMT-PLOT-PROTO :new raw trans fit-trans ssp args)))
    (when show (send p :show-window))
    p))

(defproto LSMT-PLOT-PROTO 
  '(spreadplot-supervisor showing 
        raw trans fit-trans fit-raw add-lsmt-line r-initial r-trans
                         ; unnormalized-fit-trans unnormalized-trans
        trans-raw-x-lsc trans-raw-y-lsc trans-trans-x-lsc trans-trans-y-lsc 
        pc  line-indices) () scatterplot2-proto)
    

; slot-accessor methods

(defmeth LSMT-PLOT-PROTO :line-indices (&optional (list nil set)) 
  (when set (setf (slot-value 'line-indices ) list)) 
  (slot-value 'line-indices ))

(defmeth LSMT-PLOT-PROTO :spreadplot-supervisor (&optional (obj-id nil set)) 
  (when set (setf (slot-value 'spreadplot-supervisor) obj-id)) 
  (slot-value 'spreadplot-supervisor))

(defmeth LSMT-PLOT-PROTO :r-initial (&optional (r nil set)) 
  (when set (setf (slot-value 'r-initial) r)) 
  (slot-value 'r-initial))

(defmeth LSMT-PLOT-PROTO :r-trans (&optional (r nil set)) 
  (when set (setf (slot-value 'r-trans) r)) 
  (slot-value 'r-trans))

(defmeth LSMT-PLOT-PROTO :raw (&optional (list nil set)) 
  (when set (setf (slot-value 'raw ) list)) 
  (slot-value 'raw ))

(defmeth LSMT-PLOT-PROTO :trans (&optional (list nil set)) 
  (when set (setf (slot-value 'trans) list)) 
  (slot-value 'trans))

(defmeth LSMT-PLOT-PROTO :fit-raw (&optional (pt-coords nil set)) 
  (when set (setf (slot-value 'fit-raw) pt-coords)) 
  (slot-value 'fit-raw))

(defmeth LSMT-PLOT-PROTO :fit-trans (&optional (pt-coords nil set)) 
  (when set (setf (slot-value 'fit-trans) pt-coords)) 
  (slot-value 'fit-trans))

(defmeth LSMT-PLOT-PROTO :trans-raw-x-lsc  (&optional (line-coords nil set)) 
  (when set (setf (slot-value 'trans-raw-x-lsc ) line-coords)) 
  (slot-value 'trans-raw-x-lsc ))

(defmeth LSMT-PLOT-PROTO :trans-raw-y-lsc  (&optional (line-coords nil set)) 
  (when set (setf (slot-value 'trans-raw-y-lsc) line-coords)) 
  (slot-value 'trans-raw-y-lsc))

(defmeth LSMT-PLOT-PROTO :trans-trans-x-lsc  (&optional (line-coords nil set)) 
  (when set (setf (slot-value 'trans-trans-x-lsc) line-coords)) 
  (slot-value 'trans-trans-x-lsc))

(defmeth LSMT-PLOT-PROTO :trans-trans-y-lsc  (&optional (line-coords nil set)) 
  (when set (setf (slot-value 'trans-trans-y-lsc) line-coords)) 
  (slot-value 'trans-trans-y-lsc))

(defmeth LSMT-PLOT-PROTO :pc (&optional (list nil set)) 
  (when set (setf (slot-value 'pc) list)) 
  (slot-value 'pc))

(defmeth LSMT-PLOT-PROTO :show-plot ()
  (send self :show-window)
  (send self :showing t))




(defmeth LSMT-PLOT-PROTO :isnew (raw trans fit-trans ssp &rest args) 
  (let* ( 
         (mod (send ssp :model))     
         (morals-model (send mod :morals-model))
         (non-lin-reg (if (equalp (send mod :method) "Robust") 
                          (send mod :robust-model) morals-model))
         (lin-reg (send mod :lin-reg-model))
         (labels (send (send ssp :model) :labels))
         (color 'black)
         (line-color 'black)
         )
    (send self :stuff-slots ssp)
    #+color(when (> *color-mode* 0)
                 (setf color 'blue)
                 (setf line-color 'dark-green) 
                 (send self :use-color t))
    (send self :spreadplot-supervisor ssp)
    (send self :menu-title "Regres")
    (apply #'call-next-method (list raw fit-trans) 
           :title "Regression & Fit"
           ;LS Monotone Transformation
           args)
    ;(send self :legend3L (format nil "R =~5,2f" (fuzz R 2)))
    (apply #'send self :range 1 (send self :range 0)); 0 1 
    (send self :clear)
    (send self :mouse-mode 'brushing)
    (send self :add-points (list fit-trans raw trans) 
          :point-labels labels :color color);raw fit
    (when (not (send ssp :simple-reg))
          (send self :plot-buttons :new-x nil :new-y nil)); :options t ;:switch t
    (send self :adjust-to-data)
    (send self :make-scatterplot-curves)
    (send self :switch-add-regmeanline)
  self))



(defmeth LSMT-PLOT-PROTO :stuff-slots (sps &key initial)
  (let* (
         (mod (send sps :model))     
         (morals-model (send mod :morals-model))
         (non-lin-reg (if (equalp (send mod :method) "Robust") 
                          (send mod :robust-model) morals-model))
         (lin-reg (send mod :lin-reg-model))
         (rank-order)
         (raw (send lin-reg :y))
         (fit-raw (send lin-reg :fit-values))
         (trans (send non-lin-reg :y))
         (fit-trans (send non-lin-reg :fit-values))
         )  
    (send self :raw raw)
    (send self :fit-raw fit-raw)
    (send self :trans trans)
    (send self :fit-trans :fit-trans)))

(defmeth LSMT-PLOT-PROTO :iter8 ()
  (send (send self :spreadplot-supervisor) :iterate2))

(defmeth morals-spreadplot-supervisor-proto :update-transformation-plot 
  (raw trans fit-trans) 
  (let ((plot (send self :transformation-plot)))
    (send plot :update-plot raw trans fit-trans);raw trans fit? 
    plot))

(defmeth morals-spreadplot-supervisor-proto :update-linearized-splot ()
  (send (send self :transformation-plot):show-linearized t))

(defmeth LSMT-PLOT-PROTO :update-plot (raw trans fit-trans)
  (let* ((rank-order (order raw))
         (X (select raw rank-order))
         (Y (select trans rank-order))
         (sps (send self :spreadplot-supervisor))
         (model (send (send sps :model) :morals-model))
         (labels (send (send sps :model) :labels))
         )
    #+color(when (> *color-mode* 0)
                 (send self :use-color t))
    (send self :start-buffering)
    (send self :clear-lines)
    (send self :add-lines X Y :color 'dark-green)
    (send self :clear-points)
    (send self :add-points raw fit-trans :point-labels labels :color 'blue)
    (send self :trans trans)
    (send self :fit-trans fit-trans)
    ;(send self :abline 0 1)
    ;(send self :adjust-to-data) 
    (send self :redraw-curves)
    (send self :redraw)
    (send self :buffer-to-screen)
    self))



(defmeth lsmt-plot-proto :show-linearized (&optional bayes)
  (let* ((morals-splot (send self :spreadplot-supervisor))
         (mod (send morals-splot :model))
         (avp (send morals-splot :added-var-plot))
         (reg (send morals-splot :lin-reg-plot))
         (resid (send morals-splot :residual-plot2))
         (dv (select (send mod :variables) (send mod :dv))))
    (send self :variable-label 1 (strcat "Linearized " (first dv)))
    (send self :show-reg nil)
    (send resid :variable-label 1 "Residuals")
    (send morals-splot :get-residuals resid (if bayes 5 4))
    
    ))

(defmeth lsmt-plot-proto :show-linear (&optional bayes value)
  (let* ((morals-splot (send self :spreadplot-supervisor))
         (mod (send morals-splot :model))
         (avp (send morals-splot :added-var-plot))
         (reg (send morals-splot :lin-reg-plot))
         (resid (send morals-splot :residual-plot2))
         (dv (select (send mod :variables) (send mod :dv))))
    (send self :variable-label 1 (first dv))
    (send self :show-reg t)
    (send resid :variable-label 1 "Residuals")
    (send morals-splot :get-residuals resid (if bayes 1 0))
    ))
    

(defmeth LSMT-PLOT-PROTO :show-reg (ols?)
  (let* ((sps (send self :spreadplot-supervisor))
       
         (mod (send sps :model))     
         (morals-model (send mod :morals-model))
         (non-lin-reg (if (equalp (send mod :method) "Robust") 
                          (send mod :robust-model) morals-model))
         (lin-reg (send mod :lin-reg-model))
         (raw (send lin-reg :y))
         (fit-raw (send lin-reg :fit-values))
         (trans (send non-lin-reg :y))
         (fit-trans (send non-lin-reg :fit-values))
         (min (min (combine raw trans fit-raw fit-trans)))
         (max (max (combine raw trans fit-raw fit-trans)))
         (gnr (get-nice-range min max 5))
         (point-indices (iseq (length raw)))
        
         (r)
         )
    (send self :start-buffering)
    (send self :range 0 (first gnr) (second gnr))
    (send self :range 1 (first gnr) (second gnr))
    (send self :x-axis t t (third gnr))
    (send self :y-axis t t (third gnr))
#|
    (cond
      (ols?
       (send self :point-coordinate 0 point-indices fit-raw)
       (send self :point-coordinate 1 point-indices raw)
       (send self :regvalues :renew t)
       (send self :clear-lines)
       ;(send self :add-lsmt? t)
       ;(send self :add-lsmt :plot-based t :color 'dark-green)
      ; (if (send self :add-lsmt?)
      ;     (send self :add-lsmt :plot-based t :color 'dark-green))
       (send self :r-initial (correlation fit-raw raw))
       )
      (t
       (send self :point-coordinate 0 point-indices fit-trans)
       (send self :point-coordinate 1 point-indices trans)
       (send self :regvalues :renew t)
       (send self :clear-lines)  
       ;(send self :add-lsmt? nil)
       (send self :r-trans (correlation fit-trans trans))))
    (when (send self :add-regline?) (send self :add-regline))
    (when (send self :add-regresiduals?)(send self :add-regresiduals))
    (when (send self :add-regcontour?) (send self :add-regcontour))
    (send self :redraw-curves)
|#
    
    (send self :point-coordinate 0 point-indices (if ols? fit-raw fit-trans))
    (send self :point-coordinate 1 point-indices (if ols? raw trans))
    (send self :regvalues :renew t)
    (send self :clear-lines)  
    
    
    (send self :r-trans (correlation fit-trans trans))
    (when (send self :add-regline?) (send self :add-regline))
    (when (send self :add-regresiduals?)(send self :add-regresiduals))
    (when (send self :add-lsmt?) (send self :add-lsmt))
    (send self :add-regmeanline? t)
    (send self :add-regmeanline)
   ; (when (send self :add-regcontour?) (send self :add-regcontour))
    ;(send self :redraw)
    (send self :buffer-to-screen)
    ))

(defmeth lsmt-plot-proto :add-lsmt (&key (color 'dark-green) (plot-based nil used?))
  (call-next-method nil nil :color color))

#|
(defmeth lsmt-plot-proto :add-lsmt (&key (color 'dark-green) (plot-based nil used?))
  (cond 
    ((or (not used?) plot-based) 
     (call-next-method nil nil :color color))
    (t
     (let* ((n (send self :num-points))
            (curvar (send self :current-variables))
            (y-values (send self :point-coordinate (second curvar) (iseq n)))
            (sps (send self :spreadplot-supervisor))
            (wrong-model (send sps :model))
            (model (send wrong-model :morals-model)) 
           ; (x-values (send model :Y));
            (x-values (send self :trans))
            (x-ranks (order x-values))
            (x-ordered (select x-values x-ranks))
            (y-ranks (order y-values))
            (y-ordered (select y-values y-ranks)))
       (send self :add-lines  x-ordered y-ordered :color color)
       )))
  )
|#